home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ShareWare OnLine 2
/
ShareWare OnLine Volume 2 (CMS Software)(1993).iso
/
infor
/
wpj13.zip
/
OWNDRAW.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-02-15
|
6KB
|
170 lines
unit OwnDraw;
{ This unit allows you to create BWCC style buttons without using BWCC.DLL.
It is by Todd T. Snoddy, and the source code is Copyright ⌐ Todd T. Snoddy.
You may use this unit as you like in your own programs. I can be contacted via
Compuserve email at 71044,1653 or Internet at tsnoddy@nyx.cs.du.edu, or on
America OnLine at TSnoddy. }
interface
uses WObjects, WinTypes, WinProcs;
type ButtonState = (Normal, Focused, Pressed);
type
PODButton = ^TODButton;
TODButton = object(TButton)
HNormal, HPressed, HFocused :HBitmap;
State:ButtonState;
InitialDefault, IsCreating, HasCreated : Boolean;
constructor Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
X,Y,W,H:Integer;IsDefault:Boolean;BMP:Integer);
constructor InitResource (AParent : PWindowsObject; ResourceID : Word; IsDefault : Boolean);
destructor Done;virtual;
procedure DrawItem(var Msg:TMessage);virtual;
procedure WMDrawItem (var Msg : TMessage); virtual wm_First+wm_DrawItem;
procedure WMSetFocus (var Msg : TMessage); virtual wm_First+wm_SetFocus;
end;
type
POwnerDialog = ^TOwnerDialog;
TOwnerDialog = object (TDialog)
Button : PODButton;
procedure WMDrawItem (var Msg : TMessage); virtual wm_First+wm_DrawItem;
procedure NewButton (ID : Integer; IsDefault : Boolean);
end;
implementation
procedure TOwnerDialog.WMDrawItem(var Msg:TMessage);
var
PDrawStruct : ^TDrawItemStruct;
begin
PDrawStruct := Pointer(Msg.lParam);
case PDrawStruct^.CtlType of { Insure that message is for button control }
odt_Button: SendDlgItemMsg (PDrawStruct^.CtlID, wm_DrawItem, Msg.wParam, Msg.lParam);
{ Notify button object that dialog received wm_DrawItem }
end;
end;
procedure TOwnerDialog.NewButton (ID : Integer; IsDefault : Boolean);
begin
Button := New (PODButton, InitResource (@Self, ID, IsDefault));
end;
constructor TODButton.Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
X,Y,W,H:Integer;IsDefault:Boolean;BMP:Integer);
begin
TButton.Init(AParent,AnID,ATitle,X,Y,W,H,IsDefault);
Attr.Style := Attr.Style or bs_OwnerDraw;
IsCreating := True;
HasCreated := False;
if IsDefault then
InitialDefault := True
else
InitialDefault := False;
HNormal := LoadBitmap (HInstance, MakeIntResource (BMP+1000));
HPressed := LoadBitmap (HInstance, MakeIntResource (BMP+3000));
HFocused := LoadBitmap (HInstance, MakeIntResource (BMP+5000));
end;
constructor TODButton.InitResource (AParent : PWindowsObject; ResourceID : Word;
IsDefault : Boolean);
begin
TButton.InitResource (AParent, ResourceID);
{ Call parent's InitResource object }
IsCreating := True;
HasCreated := False;
Attr.Style := Attr.Style or bs_OwnerDraw;
if IsDefault then
InitialDefault := True
else
InitialDefault := False;
{ Load the bitmaps for this button }
HNormal := LoadBitmap (HInstance, MakeIntResource (ResourceID+1000));
HPressed := LoadBitmap (HInstance, MakeIntResource (ResourceID+3000));
HFocused := LoadBitmap (HInstance, MakeIntResource (ResourceID+5000));
end;
destructor TODButton.Done;
begin
TButton.Done;
DeleteObject(HNormal); { Delete normal bitmap from memory }
DeleteObject (HFocused); { Delete focused bitmap from memory }
DeleteObject (HPressed); { Delete pressed bitmap from memory }
end;
procedure TODButton.WMDrawItem (var Msg : TMessage);
begin
DrawItem (Msg); { Call the procedure to display button }
end;
procedure TODButton.WMSetFocus (var Msg : TMessage);
{ This is necessary to properly display the focus at all times }
begin
InvalidateRect (HWindow, nil, False);
UpdateWindow (HWindow);
DefWndProc (Msg);
end;
procedure TODButton.DrawItem(var Msg:TMessage);
{ This is the procedure that actually draws the proper bitmap }
var
OldBitMap, NewBitMap:HBitMap;
MemDC :HDC;
PDrawStruct :^TDrawItemStruct;
X,Y,W,H:Integer;
Rect : TRect;
bm : TBitmap;
begin
PDrawStruct := Pointer(Msg.lParam);
GetClientRect (HWindow, Rect);
State := Normal;
if (PDrawStruct^.itemAction and oda_Select ) > 0 then
begin
if (PDrawStruct^.itemState and ods_Selected) > 0 then
State := Pressed
else
if (PDrawStruct^.itemState and ods_Focus) > 0 then
State := Focused
else
State := Normal;
end;
if ((PDrawStruct^.itemAction and oda_Focus) > 0)
and not ((PDrawStruct^.itemAction and oda_Select) > 0) then
begin
if (PDrawStruct^.itemState and ods_Focus) > 0 then
State := Focused
else
State := Normal;
end;
X := PDrawStruct^.rcItem.left;Y := PDrawStruct^.rcItem.top;
W := PDrawStruct^.rcItem.right-PDrawStruct^.rcItem.left;
H := PDrawStruct^.rcItem.bottom-PDrawStruct^.rcItem.top;
MemDC := CreateCompatibleDC(PDrawStruct^.HDC);
{ Following bitmaps are already initialized in InitResource }
if IsCreating and InitialDefault and HasCreated then
begin
IsCreating := False;
State := Focused;
end;
case State of
Normal : NewBitMap := HNormal;
Pressed : NewBitMap := HPressed;
Focused : NewBitMap := HFocused;
end;
OldBitMap := SelectObject (MemDC, NewBitMap);
GetObject (NewBitMap, sizeof (TBitmap), @bm);
{ Uses StretchBlt instead of BitBlt so that button is
resolution independent. }
StretchBlt (PDrawStruct^.HDC, 0, 0, Rect.right-1, Rect.bottom-1,
MemDC, 0, 0, bm.bmWidth, bm.bmHeight, SrcCopy);
SelectObject(MemDC,OldBitMap);
DeleteDC(MemDC);
HasCreated := True;
Msg.Result := 1; { Good practice, although not strictly necessary }
end;
end.